module Main where

import Graphics.UI.WX
import Test.QuickCheck

------------------------------------------------------------------------

sizeX, sizeY, maxY, radius :: Int
sizeX  = 300
sizeY  = 400
maxY   = 400 - radius
radius = 10

------------------------------------------------------------------------

main :: IO ()
main = start ballsFrame

ballsFrame :: IO ()
ballsFrame =
  do frm   <- frame      [ text := "Bouncing Balls" ]
     balls <- variable   [ value := [] ]
     pan   <- panel frm  [ on paint := draw balls
                         , on click := ball balls
                         ]
     tim   <- timer frm  [ interval := 20,  on command := move balls pan ]
     new   <- button frm [ text := "New",   on command := ballsFrame ]
     cls   <- button frm [ text := "Close", on command := close frm ]
     set frm [ layout :=
                 column 5
                 [ minsize (sz sizeX sizeY) (widget pan)
                 , floatCenter (row 5 [ widget new, widget cls ])
                 ]
             ]

------------------------------------------------------------------------

draw :: Var [Ball] -> DC a -> rect -> IO ()
draw balls dc area =
  do bs <- get balls value
     sequence_ [ circle dc p radius [ brushColor := red ] | p:_ <- bs ]

ball :: Var [Ball] -> Point -> IO ()
ball balls p =
  do bs <- get balls value
     set balls [ value := (bounce p 0 : bs) ]

move :: Var [Ball] -> Panel () -> IO ()
move balls pan =
  do bs <- get balls value
     set balls [ value := step bs ]
     repaint pan

{-
-- alternatively:
ball :: Var [Ball] -> Point -> IO ()
ball balls p =
  do set balls [ value :~ (bounce p 0 :) ]

move :: Var [Ball] -> Panel () -> IO ()
move balls pan =
  do set balls [ value :~ step ]
     repaint pan
-}

------------------------------------------------------------------------

type Ball = [Point]

bounce :: Point -> Int -> Ball
bounce p@(Point x y) v
  | v == 0 && y == maxY = []
  | y' > maxY           = bounce p (2-v)
  | otherwise           = p : bounce (Point x y') (v+1)
 where
  y' = y+v

step :: [Ball] -> [Ball]
step bs = [ ps' | p:ps' <- bs ]

prop_Bouncing x y =
  0 <= y && y <= maxY ==>
    finite (bounce (Point x y) 0)
 where
  finite xs = xs == xs
   
------------------------------------------------------------------------

